home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
akcl
/
kcl.lha
/
lsp
/
mislib.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
8KB
|
373 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "mislib.h"
init_mislib(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
base[0]= VV[0];
(void)simple_symlispcall_no_event(VV[34],base+0,1);
MM(VV[35],L2,start,size,data);
base[0]= VV[9];
base[1]= VV[10];
(void)simple_symlispcall_no_event(VV[36],base+0,2);
base[0]= VV[11];
base[1]= VV[12];
(void)simple_symlispcall_no_event(VV[36],base+0,2);
MF(VV[37],L7,start,size,data);
MF(VV[38],L8,start,size,data);
data->v.v_self[27]=VV[27]=string_to_object(VV[27]);
vs_top=sup;
MF(VV[39],L9,start,size,data);
MF(VV[40],L10,start,size,data);
vs_top=vs_base=base;
}
/* macro definition for TIME */
static L2()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
check_arg(2);
vs_top=sup;
{object V1=base[0]->c.c_cdr;
if(endp(V1))invalid_macro_call();
base[2]= (V1->c.c_car);
V1=V1->c.c_cdr;
if(!endp(V1))invalid_macro_call();}
base[3]= list(2,VV[7],base[2]);
base[4]= list(3,VV[5],VV[6],base[3]);
base[5]= listA(6,VV[1],VV[2],VV[3],VV[4],base[4],VV[8]);
vs_top=(vs_base=base+5)+1;
return;
}
/* function definition for LEAP-YEAR-P */
static L7()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
check_arg(1);
vs_top=sup;
TTL:;
base[2]= base[0];
base[3]= VV[13];
vs_top=(vs_base=base+2)+2;
Lmod();
vs_top=sup;
base[1]= vs_base[0];
if(number_compare(small_fixnum(0),base[1])==0){
goto T11;}
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
T11:;
base[3]= base[0];
base[4]= VV[14];
vs_top=(vs_base=base+3)+2;
Lmod();
vs_top=sup;
base[2]= vs_base[0];
if(!(((number_compare(small_fixnum(0),base[2])==0?Ct:Cnil))==Cnil)){
goto T16;}
base[2]= Ct;
vs_top=(vs_base=base+2)+1;
return;
T16:;
base[3]= base[0];
base[4]= VV[15];
vs_top=(vs_base=base+3)+2;
Lmod();
vs_top=sup;
base[2]= vs_base[0];
base[3]= (number_compare(small_fixnum(0),base[2])==0?Ct:Cnil);
vs_top=(vs_base=base+3)+1;
return;
}
/* function definition for NUMBER-OF-DAYS-FROM-1900 */
static L8()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= one_minus(base[0]);
base[3]= number_minus(base[0],VV[16]);
base[2]= number_times(base[3],VV[17]);
base[4]= base[1];
base[5]= VV[13];
vs_top=(vs_base=base+4)+2;
Lfloor();
vs_top=sup;
base[3]= vs_base[0];
base[6]= base[1];
base[7]= VV[14];
vs_top=(vs_base=base+6)+2;
Lfloor();
vs_top=sup;
base[5]= vs_base[0];
base[4]= number_negate(base[5]);
base[6]= base[1];
base[7]= VV[15];
vs_top=(vs_base=base+6)+2;
Lfloor();
vs_top=sup;
base[5]= vs_base[0];
base[6]= VV[18];
vs_top=(vs_base=base+2)+5;
Lplus();
return;
}
/* function definition for DECODE-UNIVERSAL-TIME */
static L9()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
if(vs_top-vs_base<1) too_few_arguments();
if(vs_top-vs_base>2) too_many_arguments();
vs_base=vs_base+1;
if(vs_base>=vs_top){vs_top=sup;goto T37;}
vs_top=sup;
goto T38;
T37:;
base[1]= symbol_value(VV[19]);
T38:;
base[2]= Cnil;
base[3]= Cnil;
base[4]= Cnil;
base[5]= Cnil;
base[6]= Cnil;
base[7]= Cnil;
base[8]= Cnil;
base[9]= number_times(base[1],VV[20]);
base[0]= number_minus(base[0],base[9]);
base[9]= base[0];
base[10]= VV[12];
vs_top=(vs_base=base+9)+2;
Lfloor();
if(vs_base<vs_top){
base[5]= vs_base[0];
vs_base++;
}else{
base[5]= Cnil;}
if(vs_base<vs_top){
base[0]= vs_base[0];
}else{
base[0]= Cnil;}
vs_top=sup;
base[9]= base[5];
base[10]= VV[21];
vs_top=(vs_base=base+9)+2;
Lmod();
vs_top=sup;
base[8]= vs_base[0];
base[9]= base[0];
base[10]= VV[20];
vs_top=(vs_base=base+9)+2;
Lfloor();
if(vs_base<vs_top){
base[4]= vs_base[0];
vs_base++;
}else{
base[4]= Cnil;}
if(vs_base<vs_top){
base[0]= vs_base[0];
}else{
base[0]= Cnil;}
vs_top=sup;
base[9]= base[0];
base[10]= VV[22];
vs_top=(vs_base=base+9)+2;
Lfloor();
if(vs_base<vs_top){
base[3]= vs_base[0];
vs_base++;
}else{
base[3]= Cnil;}
if(vs_base<vs_top){
base[2]= vs_base[0];
}else{
base[2]= Cnil;}
vs_top=sup;
base[10]= base[5];
base[11]= VV[23];
vs_top=(vs_base=base+10)+2;
Lfloor();
vs_top=sup;
base[9]= vs_base[0];
base[7]= number_plus(VV[16],base[9]);
base[9]= Cnil;
T65:;
base[12]= base[7];
vs_top=(vs_base=base+12)+1;
L8();
vs_top=sup;
base[11]= vs_base[0];
base[9]= number_minus(base[5],base[11]);
base[10]= base[9];
base[12]= base[7];
vs_top=(vs_base=base+12)+1;
L7();
vs_top=sup;
if((vs_base[0])==Cnil){
goto T75;}
base[11]= VV[23];
goto T73;
T75:;
base[11]= VV[17];
T73:;
if(!(number_compare(base[10],base[11])<0)){
goto T66;}
base[5]= one_plus(base[9]);
goto T63;
T66:;
base[7]= number_plus(base[7],VV[24]);
goto T65;
T63:;
base[9]= base[7];
vs_top=(vs_base=base+9)+1;
L7();
vs_top=sup;
if((vs_base[0])==Cnil){
goto T84;}
if(!(number_compare(base[5],VV[22])==0)){
goto T88;}
base[9]= base[2];
base[10]= base[3];
base[11]= base[4];
base[12]= VV[25];
base[13]= VV[26];
base[14]= base[7];
base[15]= base[8];
base[16]= Cnil;
base[17]= base[1];
vs_base=base+9;vs_top=base+18;
return;
T88:;
if(!(number_compare(base[5],VV[22])>0)){
goto T84;}
base[5]= number_minus(base[5],VV[24]);
T84:;
base[9]= VV[27];
T105:;
if(!(number_compare(base[5],car(base[9]))<=0)){
goto T106;}
base[10]= make_fixnum(length(base[9]));
base[6]= number_minus(VV[28],base[10]);
goto T103;
T106:;
base[5]= number_minus(base[5],car(base[9]));
base[9]= cdr(base[9]);
goto T105;
T103:;
base[9]= base[2];
base[10]= base[3];
base[11]= base[4];
base[12]= base[5];
base[13]= base[6];
base[14]= base[7];
base[15]= base[8];
base[16]= Cnil;
base[17]= base[1];
vs_base=base+9;vs_top=base+18;
return;
}
/* function definition for ENCODE-UNIVERSAL-TIME */
static L10()
{ register object *base=vs_base;
register object *sup=base+VM7;
vs_reserve(VM7);
if(vs_top-vs_base<6) too_few_arguments();
if(vs_top-vs_base>7) too_many_arguments();
vs_base=vs_base+6;
if(vs_base>=vs_top){vs_top=sup;goto T125;}
vs_top=sup;
goto T126;
T125:;
base[6]= symbol_value(VV[19]);
T126:;
base[2]= number_plus(base[2],base[6]);
base[7]= VV[29];
base[8]= base[5];
base[9]= VV[30];
vs_top=(vs_base=base+7)+3;
Lmonotonically_nondecreasing();
vs_top=sup;
if((vs_base[0])==Cnil){
goto T130;}
symlispcall_no_event(VV[41],base+8,0);
Llist();
vs_top=sup;
base[7]= vs_base[0];
base[8]= car(base[7]);
base[9]= cadr(base[7]);
base[10]= caddr(base[7]);
base[11]= cadddr(base[7]);
base[12]= car(cddddr(base[7]));
base[13]= cadr(cddddr(base[7]));
base[14]= caddr(cddddr(base[7]));
base[15]= cadddr(cddddr(base[7]));
base[16]= nth(8,base[7]);
base[18]= base[13];
base[19]= VV[14];
vs_top=(vs_base=base+18)+2;
Lmod();
vs_top=sup;
base[17]= vs_base[0];
base[18]= number_minus(base[13],base[17]);
base[5]= number_plus(base[5],base[18]);
base[17]= number_minus(base[5],base[13]);
if(!(number_compare(base[17],VV[32])<0)){
goto T153;}
base[5]= number_plus(base[5],VV[14]);
goto T130;
T153:;
base[17]= number_minus(base[5],base[13]);
if(!(number_compare(base[17],VV[33])>=0)){
goto T130;}
base[5]= number_minus(base[5],VV[14]);
T130:;
base[7]= base[5];
vs_top=(vs_base=base+7)+1;
L7();
vs_top=sup;
if((vs_base[0])==Cnil){
goto T160;}
if(number_compare(base[4],VV[26])>0){
goto T159;}
T160:;
base[3]= number_minus(base[3],VV[24]);
T159:;
base[9]= base[3];
base[11]= base[5];
vs_top=(vs_base=base+11)+1;
L8();
vs_top=sup;
base[10]= vs_base[0];
{object V2;
base[11]= VV[27];
base[12]= number_minus(VV[28],base[4]);
vs_top=(vs_base=base+11)+2;
Lbutlast();
vs_top=sup;
V2= vs_base[0];
vs_top=base+11;
while(!endp(V2))
{vs_push(car(V2));V2=cdr(V2);}
vs_base=base+9;}
Lplus();
vs_top=sup;
base[8]= vs_base[0];
base[7]= number_times(base[8],VV[12]);
base[8]= number_times(base[2],VV[20]);
base[9]= number_times(base[1],VV[22]);
base[10]= base[0];
vs_top=(vs_base=base+7)+4;
Lplus();
return;
}